Milestone #4

Map of New Infections by County

# map of new infections by county

ca_counties <- map_data("county") %>%
  filter(region == "california")

stratified_rate_infections_lower <- stratified_rate_infections %>%
  mutate(county = str_to_lower(county))

map_data <- ca_counties %>%
  left_join(stratified_rate_infections_lower, by = c("subregion" = "county"))

# map

long_caption <- "The map shows that Imperial County has the highest new infections in 2023. It appears that the coastal counties may have a lower rate of new infections."
wrapped_caption <- str_wrap(long_caption, width = 50) 

       

ggplot(map_data, aes(long, lat, group = group, fill = new_infections_per_capita)) +
  geom_polygon(color = "white") +
  scale_fill_viridis_c(option = "magma", limits = c(0,50), na.value = "grey") +
  labs(title = "Heat Map of New Infections per Capita by County, 2023", fill = "Infection Rate", caption = wrapped_caption) +
  theme_void() + 
  theme(
  plot.title = element_text(hjust = 0.5, margin = margin(b = 10)),
  legend.position = "right",
  legend.title = element_text(size = 10),
  legend.text = element_text(size = 8),
  plot.margin = margin(t = 20, r = 20, b = 20, l = 20)
)

Table of Infections Per Capita per Race/Ethnicity and County

race_infections_table <- race_infections_clean %>%

select(County, `American Indian or Alaska Native Non-Hispanic`, `Asian Non-Hispanic’, Black Non-Hispanic`, `Hispanic (Any Race)`, `Multiracial (Two or More Above Races)`, `Total Infections per Capita per County`)

(

“American Indian or Alaska Native (Non-Hispanic)”,

“Asian (Non-Hispanic)”,

“Black (Non-Hispanic)”,

“Hispanic (Any Race)”,

“Multiracial (Two or More of Above Races)”,

“Native Hawaiian or Pacific Islander (Non-Hispanic)”

“White (Non-Hispanic)”

)

race_infections_table,

options = list(

pageLength = 15,

scrollX = TRUE,

autoWidth = TRUE

)

) %>%

formatStyle(

columns = 2,

valueColumns = 2,

color = styleEqual(race_infections_table\[8, 2\], ‘red’)

) %>%

formatStyle(

columns = 8,

valueColumns = 8,

color = styleEqual(race_infections_table\[8, 8\], ‘red’)

)

#Reformatting df for Table 

race_infections_clean <- stratified_rate_infections %>%
  pivot_wider(
    id_cols = county,
    names_from = race_ethnicity,
    values_from = c("new_infections_per_capita", "pop")
  )

#Renaming columns 

colnames(race_infections_clean) <- c("County", "American Indian or Alaska Native (Non-Hispanic)", "Asian (Non-Hispanic)", "Black (Non-Hispanic)", "Hispanic (Any Race)", "Multiracial (Two or More of Above Races)", "Native Hawaiian or Pacific Islander (Non-Hispanic)", "White (Non-Hispanic)", "American Indian or Alaska Native (Non-Hispanic) Pop", "Asian (Non-Hispanic) Pop",  "Black (Non-Hispanic) Pop", "Hispanic (Any Race) Pop", "Multiracial (Two or More of Above Races) Pop", "Native Hawaiian or Pacific Islander (Non-Hispanic) Pop", "White (Non-Hispanic) Pop")

#Adding Total per Capita for each Race/Ethnic Group Category

race_group <- c(
  "American Indian or Alaska Native (Non-Hispanic)",
  "Asian (Non-Hispanic)",
  "Black (Non-Hispanic)",
  "Hispanic (Any Race)",
  "Multiracial (Two or More of Above Races)",
  "Native Hawaiian or Pacific Islander (Non-Hispanic)",
  "White (Non-Hispanic)"
)

race_sum <- race_infections_clean %>%
  summarise(across(all_of(race_group), ~ sum(.x, na.rm = TRUE))) %>%
  mutate(County = "Total per each Race/Ethnic Group")

race_infections_clean <- bind_rows(race_infections_clean, race_sum)

#Rearranging and Select the columns 

race_infections_table <- race_infections_clean %>%
  select(County, `American Indian or Alaska Native (Non-Hispanic)`, `Asian (Non-Hispanic)`, `Black (Non-Hispanic)`, `Hispanic (Any Race)`, `Multiracial (Two or More of Above Races)`, `Native Hawaiian or Pacific Islander (Non-Hispanic)`, `White (Non-Hispanic)`
)

#Creating Table Visualization

#Adding Bolded Values and Color
datatable(
  race_infections_table,
  options = list(
    pageLength = 15,
    scrollX = TRUE,
    autoWidth = TRUE
  ),
  caption = "Rate of Infections per Capita by Race and Ethnic Group per County"
) %>%
  formatRound(columns = 2:ncol(race_infections_table), digits = 2) %>%
  formatStyle(1,color="darkgreen") %>%
  formatStyle(
    columns = c(2, 8),
    fontWeight = 'bold'
  )
#Table Description: "American Indian or Alaska Native (Non-Hispanic) and White (Non-Hispanic) racial and ethnic groups have the highest per capita rates in total in California. "